Option Compare Database
Option Explicit

Function GetFileName(Optional ByVal FileType As Integer, Optional ByVal FindIn As String) As String
' فتح مربع حوار اختيار ملف إكسل
On Error Resume Next
Dim FileName As String
Dim result As Integer
Const msoFileDialogFilePicker As Long = 3
Dim objDialog As Object
With Application.FileDialog(msoFileDialogFilePicker)
.Filters.Clear
.InitialFileName = FindIn
.Title = "إختر ملف إكسل المراد الاستيراد منه"
.Filters.Add "Microsoft Excel Sheet", "*.Xls,*.Xlsx"
' .Filters.Add "All Files", "*.*"
.FilterIndex = 0
If (Not IsEmpty(FileType)) Then .FilterIndex = FileType
.AllowMultiSelect = False
result = .Show
If (result <> 0) Then
FileName = Trim(.SelectedItems.Item(1))
GetFileName = FileName
Else
GetFileName = ""
End If
End With
End Function
---------------------------------------------------------------
Private Sub Commande1_Click()
Dim mfile As String
'اختيار ملف إكسل
mfile = GetFileName
' في حالة عدم اختيار ملف يتم الإلغاء والخروج من العملية
If mfile = "" Or IsNull(mfile) = True Then Exit Sub
' استيراد الجدول وتسميته بMyTable
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel7, "MyTable", mfile, True
'مسح محتويات جدول الإجمالية قبل الإلحاق
CurrentDb.Execute "DELETE الإجمالية.* FROM الإجمالية;"
'إلحاق بيانات الجدولMyTable بجدول الإجمالية
CurrentDb.Execute "INSERT INTO الإجمالية" _
& " SELECT MyTable.* FROM MyTable;"
' 'حذف الجدول
CurrentDb.Execute "DROP TABLE [MyTable]"
' تحديث بيانات المصدر
Me.Requery
End Sub

